unit CPUID;
(** ////////////////////////////////////////////////////////////////////// //**)
(**(c) NPS, 1997 	- Idea, realisation, adoptation IsCPUID_Available)   **)
(**                       kvk@estpak.ee                                      **)
(**(c) Alex Abreu, 1997 - IsCPUID_Available source and idea                  **)
(**                       simonet@bhnet.com.br                               **)
(** Gordon Bamber,June1998 Converted into a class + VCL                      **)
(**                       gbamber@mistral.co.uk                              **)
(** This code is presented 'as-is' and is not a commercial product.          **)
(** It compiles under Delphi 3.0 and is lightly, though adequately commented **)
(** Please do not distribute variants without including, and adding to this  **)
(** header information, and incrementing C_VERSIONSTRING		     **)
(** VERSION HISTORY							     **)
(** Version 1.0 Gordon Bamber						     **)
(**		VCL coded						     **)
(** Version 1.1 Gordon Bamber						     **)
(**		Public methods expanded to use TimeStamp more easily         **)
(** Version 1.2 Gordon Bamber						     **)
(** 		added FormatSeconds and check_80286, 80386 80486             **)
(** Version 1.3 Diego Finochietto       				     **)
(** 		added                                                        **)
(** /////////////////////////////////////////////////////////////////////////**)

interface
uses Windows,SysUtils,Classes,Registry;

const
 C_DLLNAME='CPUID';
 C_VERSIONSTRING='1.03';


 ID_BIT=$200000; (** EFLAGS ID bit **)
 C_SHOWWHOLESECONDSONLY=TRUE;
 C_DONTSHOWWHOLESECONDSONLY=FALSE;
 C_DISPLAYALL=TRUE;
 C_DONTDISPLAYALL=FALSE;
 type
 TCPUIDARRAY=array[1..4] of Longint;
 TVendor=array [0..11] of char;
type
  TCPUID = class(TComponent)
  private
    { Private declarations }
   Fabout: string;
   fsVersion:String;
   fIDAvailable:Boolean;
   fId1:LongInt;
   fId2:LongInt;
   fId3:LongInt;
   fId4:LongInt;
   fProcessorType:LongInt;
   fFamily:LongInt;
   fModel:LongInt;
   fStepping:LongInt;
   fVendor:TVendor;
   fsVendor:String;
   fCPUSpeed:Comp;
   fCPUSpeedMhz:Double;
   fExactCPUSpeed:Double;

   fsIntelModel:String;
   fTimeStamp1:Word;
   fTimeStamp2:Word;
   fTimeStamp3:Word;
   fTimeStamp4:Word;

   fHasFPU:Boolean;
   fHasTimeStamp:Boolean;
   fHasAPIC:Boolean;


   (** Persistent stuff **)
   fStartTime,fEndTime,fElapsed:LARGE_INTEGER;

   (** Dummies created for Property.Write values **)
   fDummyLongInt:LongInt;
   fDummyString:String;
   fDummyWord:Word;
   fDummyBool:Boolean;
   fDummyDouble:Double;

   Function GetIDInfo:Boolean;
   Function GetIntelModel:String;
   Function RegGetCPUSpeed:Comp;
  protected
    { Protected declarations }
  public
    { Public declarations }

  Constructor Create(aOwner:TComponent);override;

  Procedure RefreshTimeStamp;
  Function GetTimeStamp:LARGE_INTEGER;
  Procedure Loaded;override;

  Function SupportsTimeStamp:Boolean;
  Procedure StartTimer;
  Procedure StopTimer;
  Function GetElapsedTicks:Comp;
  Function GetTicksPerSecond(ITERATIONS:Word):Comp;
  function GetExactCpuSpeed:Double;

  Procedure ShowElapsedTime;
  Function GetElapsedSeconds:Double;
  Function GetCPUSpeed:Comp;

  Function FormatSeconds(TotalSeconds:Double;WholeSecondsOnly,DisplayAll:Boolean):String;
  Function FormatWithCommas(n:DWORD):String;

  published
    { Published declarations }
   property About: string read FAbout write FAbout;

   Property CPUID1:LongInt
    read fID1 write fDummyLongInt stored False;

   Property CPUID2:LongInt
    read fID2 write fDummyLongInt stored False;

   Property CPUID3:LongInt
    read fID3 write fDummyLongInt stored False;

   Property CPUID4:LongInt
    read fID4 write fDummyLongInt stored False;

   Property ProcessorType:LongInt
    read fProcessorType write fDummyLongInt stored False;

   Property ProcessorFamily:LongInt
    read fFamily write fDummyLongInt stored False;

   Property ProcessorModel:LongInt
    read fModel write fDummyLongInt stored False;

   Property ProcessorStepping:LongInt
    read fStepping write fDummyLongInt stored False;

   Property ProcessorVendor:String
    read fsVendor write fDummyString stored False;

   Property ProcessorSpeed:Double
    read fCPUSpeedMHz write fDummyDouble stored False;

   Property ProcessorDescription:String
    read fsIntelModel write fDummyString stored False;

   Property TimeStampHiHi:Word
    read fTimeStamp1 write fDummyWord stored False;

   Property TimeStampHiLo:Word
    read fTimeStamp2 write fDummyWord stored False;

   Property TimeStampLoHi:Word
    read fTimeStamp3 write fDummyWord stored False;

   Property TimeStampLoLo:Word
    read fTimeStamp4 write fDummyWord stored False;

   Property HasFPU:Boolean
    read fHasFPU write fDummyBool stored False;

   Property HasTimeStamp:Boolean
    read fHasTimeStamp write fDummyBool stored False;

   Property HasAPIC:Boolean
    read fHasAPIC write fDummyBool stored False;

   Property HasCPUID:Boolean
    read fIDAvailable write fDummyBool stored False;

   Property VCLVersion:String
    read fsVersion write fDummyString stored False;

  end;

(** These functions cannot be members of the class **)
procedure EnableCPUID;register;  // for Cyrix processors
procedure DisableCPUID;register; // for Cyrix processors
function IsCPUID_Available : Boolean;register;
function GetCPUID : TCPUIDARRAY;register;
function GetCPUVendor : TVendor;register;
function OldGetCpuSpeed: Comp;
Function GetTimeStampHi:DWord;register;
Function GetTimeStampLo:DWord;register;
function check_8086:Word;register;
function check_80286:Word;register;
function check_80386:Word;register;
function GetCPUID4 :DWORD;register;
implementation

(** Keep some internal variables to save re-calculating all the time **)

Constructor TCPUID.Create(aOwner:TComponent);
begin
Inherited Create(aOwner);
(** Initialise private members **)
fProcessorType:=0;
fFamily:=0;
fModel:=0;
fStepping:=0;
fsVendor:='Unknown Vendor';
fsIntelModel:='Not Intel';
fTimeStamp1:=0;
fTimeStamp2:=0;
fTimeStamp3:=0;
fTimeStamp4:=0;
fCPUSpeedMhz:=0;
fCPUSpeed:=RegGetCPUSpeed; (** Works with NT **)
fExactCPUSpeed:=0;
fsVersion:=C_VERSIONSTRING;
//EnableCPUID;
fIDAvailable:=GetIDInfo;
fsIntelModel:=GetIntelModel;
if (fIDAvailable) then
 begin
  (** Test bit flags of ID4 **)
  fHasFPU:=(fID4 and 1)=1;
  fHasTimeStamp:=(fID4 and 16)=16;
  fHasAPIC:=(fID4 and 512)=512;
  if fHasTimeStamp then
   begin
    RefreshTimeStamp; (** Sets the TimeStamp members **)
    if fCPUSpeed=0 then GetCPUSpeed;
   end;
 end; (** Of if fIDAvailable.. **)

(** Alternative methods for CPU Speed **)
// if fCPUSpeed=0 then fCPUSpeed:=RegGetCPUSpeed; (** Works with NT **)
if fCPUSpeed=0 then OldGetCPUSpeed; (** Last ditch try! **)

(** If GetTicksPerSecond was called then fExactCPUSpeed
    was set, and this is the best available value **)
if fExactCPUSpeed > 0 then fCPUSpeedMhz:=fExactCPUSpeed
else(** Use fCPUSpeed, but convert cycles to MegaCycles **)
 if fCPUSpeed > 0 then fCPUSpeedMhz:=fCPUSpeed/1E6;
//DisableCPUID;
end;

(******************************************************************************)

Procedure TCPUID.Loaded;
begin
Inherited Loaded;
end;

(******************************************************************************)

Function TCPUID.FormatWithCommas(n:DWORD):String;
(** Returns a string with Thousands commas in **)
Var f:Single;
begin
F:=n;
Result:=Format('%.0n',[f]);
end;

(******************************************************************************)

Function GetTimeStampHi:DWord;assembler;register;
asm
 DW      $310F       {RDTSC Command}
 MOV @Result, EDX;
end;

(******************************************************************************)

Function GetTimeStampLo:DWord;assembler;register;
asm
  DW      $310F       {RDTSC Command}
  MOV @Result, EAX;
end;

(******************************************************************************)

Procedure TCPUID.RefreshTimeStamp;
begin
if fHasTimeStamp then
 begin
  fTimeStamp1:=HiWord(GetTimeStampHi);
  fTimeStamp2:=LoWord(GetTimeStampHi);
  fTimeStamp3:=HiWord(GetTimeStampLo);
  fTimeStamp4:=LoWord(GetTimeStampLo);
 end;
end;

(******************************************************************************)

Function TCPUID.GetIntelModel:String;
Var
 s:String;
Begin
(** Check the non-CPUID processors **)
 if NOT fIDAvailable then
 begin
  Result:='80486 Processor';
  {if check_8086=0 then Result := '8086/8088 Processor';
  if check_80286=2 then Result := '80286 Processor';
  if check_80386=3 then Result := '80386 Processor';}
  exit;
 end;

 s:='Unknown Type';
 if fsVendor='GenuineIntel' then
 begin
   If fFamily=4 then (** 486 family **)
   (** Only models 4, 7 and 8 implement the CPUID instruction **)
   begin
     s := '486';
     if fProcessorType=1 then s:= s + ' Overdrive';
     if fModel < 2 then s:= s + ' DX';
     if fModel = 2 then s:= s + ' SX';
     if fModel = 3 then s:= s + ' DX2';
     if fModel = 4 then s:= s + ' SL';
     if fModel = 5 then s:= s + ' SX2';
     if fModel = 7 then s:= s + ' DX2 WriteBack';
     if fModel = 8 then s:= s + ' DX4';
   end
   else if fFamily=5 then (** Pentium Family **)
   begin
     s := 'Pentium';
     if (fProcessorType=1) and (fModel<7) then s:= s + ' Overdrive';
     case fModel of
       1: s:= s + ' 60/66 Mhz';
       2: s:= s + ' 75-200 Mhz';
       3: s:= s + ' (486 - Pentium)';
       4: s:= s + ' MMX 166/200 Mhz';
       5: s:= s + ' (486DX4 - Pentium)';
       6: s:= s + ' (75,90,100,120,133)';
       7: s:= s + ' Mobile (150~233)';
       8: s:= s + ' MMX Mobile (200~300)';
     else s := s+format(' model %d stepping %d',[fModel,fStepping]);
     end;
   end
   else if fFamily=6 then (** Pentium II and Pro Family **)
   begin
     s := 'Pentium';
     case fModel of
        0: s:=s+' Pro';
        1: s:=s+' Pro';
        3: s:=s+' II';
        4: s:=s+' II';
        5: s:=s+' II';
        6: s:=s+' II Celeron';
        7: s:=s+' III (Katmai)';
        8: s:=s+' III E (Coppermine)';
       10: s:=s+' III Xeon (Cascades)';
     else  s := s+format(' model %d stepping %d',[fModel,fStepping]);
     end;
     if fProcessorType=1 then s:= s + ' Overdrive';
   end
   else if fFamily=15 then {Pentium 4}
     s:='Intel Pentium 4'
   else s := format('family %d model %d stepping %d',[fModel,fStepping]);
   s := 'Intel '+s;
 end
 else if (fsVendor='AuthenticAMD') or (fsVendor='AMD ISBETTER') then
 begin
   case fFamily of
     4: case fModel of
           3: s := '486DX2/DX4';
           7: s := '486DX2/DX4 (WT)';
           8: s := '486DX4/5x86 3xWT';
           9: s := '486DX4 3xWB';
          14: s := '5x86 4xWT';
          15: s := '5x86 4xWB';
        else  s := format('486DX2/DX4/5x86 model %d ver %d',[fModel,fStepping]);
        end;
     5: case fModel of
           0: s := 'K5 1.5x';
           1: s := 'K5 1.5x';
           2: s := 'K5 1.75x';
           3: s := 'K5 2x';
           6: s := 'K6';
           7: s := 'K6';
           8: s := 'K6-2 3DNow!';
           9: s := 'K6-3 3DNow!&int L2';
          13: s := 'K6-2+/K6-III+';
        else  s := format('K5/K6 model %d ver %d',[fModel,fStepping]);
        end;
     6: case fModel of
           1: s := 'K7 Athlon .25u';
           2: s := 'K7 Athlon .18u';
           3: s := 'K7 Duron';
           4: s := 'K7 Athlon .18u int L2';
        else  s := format('K7 model %d ver %d',[fModel,fStepping]);
        end;
   else s := format('family %d, model %d, ver %d',[fFamily,fModel,fStepping]);
   end;
   s := 'AMD '+s;
 end
 else if fsVendor='CyrixInstead' then
   s := 'Cyrix'
 else if fsVendor='NexGenDriven' then
   s := 'NexGen'
 else if fsVendor='RiseRiseRise' then
   s := 'Rise'
 else if fsVendor='GenuineTMx86' then
   s := 'Transmeta'
 else if fsVendor='UMC UMC UMC ' then
   s := 'UMC';
 Result:=s;
End;

(******************************************************************************)

Function TCPUID.RegGetCPUSpeed:Comp;
Var
 MyReg:TRegistry;
 B:LongInt;
 Mhz:LongInt;
begin
Result:=0;
MHz:=0;
TRY
 MyReg:=TRegistry.Create;
 MyReg.RootKey:=HKEY_LOCAL_MACHINE;
 TRY
 if MyReg.OpenKey('\HARDWARE\DESCRIPTION\System\CentralProcessor\0',FALSE) then
  Begin
   B:=MyReg.ReadInteger('~MHz');
   if B > 0 Then Mhz:=B else
    B:=MyReg.ReadInteger('~Mhz');
    if B > 0 Then Mhz:=B else
    B:=MyReg.ReadInteger('~mhz');
    if B > 0 Then Mhz:=B;
  End;
 FINALLY
  MyReg.Free;
 END;
EXCEPT
 Result:=0;
END;
(** Convert MegaHertz to Hertz **)
Result:=Mhz * 1E6;
fCPUSpeed:=Result;
end;

(******************************************************************************)

Function TCPUID.SupportsTimeStamp:Boolean;
begin
Result:=FALSE;
If (GetCPUID4 and 16) = 16 then result:=TRUE;
end;

(******************************************************************************)

Function TCPUID.GetTimeStamp:LARGE_INTEGER;
begin
 Result.QuadPart:=0;
 If (GetCPUID4 and 16) <> 16 then exit; (** No Timestamp Function **)
 Result.HighPart:=DWORD(GetTimeStampHi);
 Result.LowPart:=GetTimeStampLo;
End;

(******************************************************************************)

Procedure TCPUID.StartTimer;
Begin
 (** Get raw processor ticks since power-on **)
 fStartTime:=GetTimeStamp;
 fEndTime.QuadPart:=0;
 fElapsed.QuadPart:=0;
End;

(******************************************************************************)

Procedure TCPUID.StopTimer;
Begin
 (** Get raw processor ticks since power-on **)
 fEndTime:=GetTimeStamp;
 TULargeInteger(fElapsed).QuadPart:=(TULargeInteger(fEndTime).QuadPart-TULargeInteger(fStartTime).QuadPart);
End;

(******************************************************************************)

Function TCPUID.GetElapsedTicks:Comp;
Begin
 (** Implicit 64-bit TypeCast **)
 Result:=fElapsed.QuadPart;
End;

(******************************************************************************)

Function TCPUID.GetTicksPerSecond(ITERATIONS:Word):Comp;
Var
 FREQ,PERFCOUNT,TARGET:LARGE_INTEGER;
begin
  Result:=0; (** Initialise in case of failure **)

  if NOT QueryPerformanceFrequency(int64(FREQ)) then exit;
  (** The OS or hardware may not support this API call.
      Sometimes, the FREQ is equal to Processor Ticks/Second,
      but it might not be on every system **)

  QueryPerformanceCounter(int64(PERFCOUNT));
  (** Get a start time via the OS **)

  TARGET.QuadPart:=PERFCOUNT.QuadPart + (FREQ.QuadPart * ITERATIONS);
  (** Make an end time **)

  StartTimer;
  (** Fetch the processor tickcount **)


  REPEAT (** Loop for exactly one second (according to the OS) **)
   QueryPerformanceCounter(int64(PERFCOUNT));
   UNTIL (PERFCOUNT.QuadPart >= TARGET.QuadPart);

  (** Fetch the number of processor ticks since the loop started **)
  StopTimer;
  Result:=(fElapsed.QuadPart/ITERATIONS);

 (** In MegaHertz **)
 fExactCPUSpeed:=Result/1E6;
end;

(******************************************************************************)

function TCPUID.GetExactCpuSpeed:Double;
Var
 MYCOMP:Comp;
begin
 (** Do a 10-second test **)
 MYCOMP:=GetTicksPerSecond(10);
 Result:=MYCOMP/1E6;

 (** In MegaHertz **)
 fExactCPUSpeed:=Result;
end;

(******************************************************************************)

Procedure TCPUID.ShowElapsedTime;
Var P:Array[0..255] of Char;
begin
wvsprintf(P,'%d ticks',PChar(@fElapsed.QuadPart));
MessageBox(0,P,'ShowElapsedTime',64);
end;

(******************************************************************************)

Function TCPUID.GetElapsedSeconds:Double;
Begin
 Result:=GetElapsedTicks/(fCPUSpeed);
End;

(******************************************************************************)

Function TCPUID.GetCPUSpeed:Comp;
Begin
 if fCPUSpeed=0 then fCPUSpeed:=GetTicksPerSecond(1);
 Result:=fCPUSpeed;
End;

(******************************************************************************)

(** This function is not as accurate **)
function OldGetCpuSpeed: Comp;
(** Uses RDTSC Command to get the Processor Timer count **)
var
  t: DWORD;
  mhi, mlo, nhi, nlo: DWORD;
  t0, t1, chi, clo, shr32: Comp;
begin
Result:=0;
  exit;
  shr32 := 65536;
  shr32 := shr32 * 65536;

  (** Get a start time **)
  t := GetTickCount;
  while t = GetTickCount do begin end;
  asm
    DB 0FH
    DB 031H  	(** RDTSC Opcode retrieves 64-bit tick count since boot **)
    mov mhi,edx (** 32-bit Ticks Hi **)
    mov mlo,eax (** 32-bit Ticks Lo **)
  end;

 (** Look 1 second later **)
  while GetTickCount < (t + 1000) do begin end;
  asm
    DB 0FH
    DB 031H  (** RDTSC **)
    mov nhi,edx
    mov nlo,eax
  end;

  (** See how many Processor Timer Ticks have elapsed **)
  chi := mhi; //if mhi < 0 then chi := chi + shr32;
  clo := mlo; //if mlo < 0 then clo := clo + shr32;

  t0 := chi * shr32 + clo;

  chi := nhi; //if nhi < 0 then chi := chi + shr32;
  clo := nlo; //if nlo < 0 then clo := clo + shr32;

  t1 := chi * shr32 + clo;

  Result := Round(t1 - t0);
end;

(******************************************************************************)

Function TCPUID.GetIDInfo:Boolean;
var
  I     : Integer;
  CPUIDARRAY:TCPUIDARRAY;
begin
Result:=False;
for I := Low(CPUIDARRAY) to High(CPUIDARRAY)  do CPUIDARRAY[I] := -1;
if IsCPUID_Available then
 begin
  CPUIDARRAY:=GetCPUID;

  fID1:=CPUIDARRAY[1];
  fID2:=CPUIDARRAY[2];
  fID3:=CPUIDARRAY[3];
  fID4:=CPUIDARRAY[4];

  fProcessorType:=(CPUIDARRAY[1] shr 12 and 3);
  fFamily:=(CPUIDARRAY[1] shr 8 and $f);
  fModel:=(CPUIDARRAY[1] shr 4 and $f);
  fStepping:=(CPUIDARRAY[1] and $f);
  fVendor := GetCPUVendor;
  fsVendor:=String(fVendor);
  Result:=True;
 end;
end;

(******************************************************************************)

(*
    Some processors (Cyrix) have the (ability to set the) ID bit set off by
    default. To make it possible to set this bit one has to set CPUIDEN
    (CPUID Enable, bit 7) in CCR4 (Configuration Control Register 4). But in
    order to write to CCR4 the MAPEN (Register Mapping Enable) bits in CCR3
    must have the value 0001b (=Enable access to all configuration registers).
*)

procedure EnableCPUID;assembler;register;
asm
  mov al,$c3                 // c3h = index of CCR3
  out $22,al                 // next read/write of port 23h from/to CCR3
  //wait6cycles
  nop; nop; nop; nop; nop; nop
  in al,$23                  // al = value of CCR3
  and al,$0f                 // Clear MAPEN bits
  or al,$10	             // Set MAPEN to 1 -> All registers accessible
  mov ah,al                  // Save future CCR3
  mov al,$c3
  out $22,al
  //wait6cycles
  nop; nop; nop; nop; nop; nop
  mov al,ah
  out $23,al                 // MAPEN (bits 4-7) in CCR3 are set to 0001b
  mov al,$e8		     // e8h = index of CCR4
  out $22,al                 // next read/write of port 23h from/to CCR4
  //wait6cycles
  nop; nop; nop; nop; nop; nop
  in al,$23                  // al = value of CCR4
  or al,$80                  // Set CPUIDEN (Enable CPUID instr. , bit 7)
  mov ah,al                  // Save future CCR4
  mov al,$e8
  out $22,al
  //wait6cycles
  nop; nop; nop; nop; nop; nop
  mov al,ah
  out $23,al                 // CPUIDEN (bit 7) in CCR4 is set
end;

procedure DisableCPUID;assembler;register;
asm
  mov al,$c3                 // c3h = index of CCR3
  out $22,al                 // next read/write of port 23h from/to CCR3
  //wait6cycles
  nop; nop; nop; nop; nop; nop
  in al,$23                  // al = value of CCR3
  and al,$0f                 // Clear MAPEN bits
  or al,$10	             // Set MAPEN to 1 -> All registers accessible
  mov ah,al                  // Save future CCR3
  mov al,$c3
  out $22,al
  //wait6cycles
  nop; nop; nop; nop; nop; nop
  mov al,ah
  out $23,al                 // MAPEN (bits 4-7) in CCR3 are set to 0001b
  mov al,$e8		     // e8h = index of CCR4
  out $22,al                 // next read/write of port 23h from/to CCR4
  //wait6cycles
  nop; nop; nop; nop; nop; nop
  in al,$23                  // al = value of CCR4
  and al,$7F                 // Reset CPUIDEN (Enable CPUID instr. , bit 7)
  mov ah,al                  //  -> CPUID is disabled
  mov al,$e8                 // Save future CCR4
  out $22,al
  //wait6cycles
  nop; nop; nop; nop; nop; nop
  mov al,ah
  out $23,al                 // CPUIDEN (bit 7) in CCR4 is cleared
(*  // Set MAPEN to default:
  mov al,$c3                 // c3h = index of CCR3
  out $22,al                 // next read/write of port 23h from/to CCR3
  //wait6cycles
  nop; nop; nop; nop; nop; nop
  in al,$23                  // al = value of CCR3
  and al,$0f                 // Clear MAPEN bits (default)
  mov ah,al                  // Save future CCR3
  mov al,$c3
  out $22,al
  //wait6cycles
  nop; nop; nop; nop; nop; nop
  mov al,ah
  out $23,al                 // MAPEN (bits 4-7) in CCR3 are set to 0000b
*)
end;

(******************************************************************************)

function IsCPUID_Available : Boolean;assembler;register;
asm
  PUSHFD							{direct access to flags no possible, only via stack}
  POP     EAX					{flags to EAX}
  MOV     EDX,EAX			{save current flags}
  XOR     EAX,ID_BIT	{not ID bit}
  PUSH    EAX					{onto stack}
  POPFD								{from stack to flags, with not ID bit}
  PUSHFD							{back to stack}
  POP     EAX					{get back to EAX}
  XOR     EAX,EDX			{check if ID bit affected}
  JZ      @exit				{no, CPUID not availavle}
  MOV     AL,True			{Result=True}
@exit:
end;

(******************************************************************************)

function GetCPUID : TCPUIDARRAY; assembler;register;
asm
  PUSH    EBX         	{Save affected register}
  PUSH    EDI
  MOV     EDI,EAX     	{@Result}
  MOV     EAX,1
  DW      $A20F       	{CPUID Command}
  STOSD			{CPUID[1]}
  MOV     EAX,EBX
  STOSD               	{CPUID[2]}
  MOV     EAX,ECX
  STOSD               	{CPUID[3]}
  MOV     EAX,EDX
  STOSD               	{CPUID[4]}
  POP     EDI					{Restore registers}
  POP     EBX
end;

(******************************************************************************)

function GetCPUVendor : TVendor; assembler;register;
asm
  PUSH    EBX					{Save affected register}
  PUSH    EDI
  MOV     EDI,EAX			{@Result (TVendor)}
  MOV     EAX,0
  DW      $A20F				{CPUID Command}
  MOV     EAX,EBX
  XCHG		EBX,ECX     {save ECX result}
  MOV			ECX,4
@1:
  STOSB
  SHR     EAX,8
  LOOP    @1
  MOV     EAX,EDX
  MOV			ECX,4
@2:
  STOSB
  SHR     EAX,8
  LOOP    @2
  MOV     EAX,EBX
  MOV			ECX,4
@3:
  STOSB
  SHR     EAX,8
  LOOP    @3
  POP     EDI					{Restore registers}
  POP     EBX
end;

(******************************************************************************)

function check_8086 : Word; assembler;register;
(** Returns:
   0      if processor 8086
   0xffff otherwise
**)
asm
  pushf;                   (** Push original FLAGS **)
  pop     ax;              (** Get original FLAGS **)
  mov     cx, ax;          (** Save original FLAGS **)
  and     ax, $0fff;       (** Clear bits 12-15 in FLAGS **)
  push    ax;              (** Save new FLAGS value on stack **)
  popf;                    (** Replace current FLAGS value **)
  pushf;                   (** Get new FLAGS **)
  pop     ax;              (** Store new FLAGS in AX **)
  and     ax, $0f000;      (** If bits 12-15 are set, then **)
  cmp     ax, $0f000;      (**   processor is an 8086/8088 **)
  mov     @Result, 0;      (** Turn on 8086/8088 flag **)
  je	  @is8086;  	   (** Jump if processor is 8086 or 8088 **)
  mov @Result, $ffff;
@is8086:
  push cx;
  popf;
end;

(******************************************************************************)

function check_80286 : Word; assembler;register;
(** Returns:
   2      if processor 80286
   0xffff otherwise
**)
asm
  pushf;
  pop cx;
  mov bx, cx;
  or cx, $0f000;	(** Try to set bits 12-15 **)
  push cx;		(** Save new FLAGS value on stack **)
  popf;			(** Replace current FLAGS value **)
  pushf;			(** Get new FLAGS **)
  pop ax;		(** Store new FLAGS in AX **)
  and ax, $0f000;	(** If bits 12-15 are clear **)
  mov @Result, 2;	(** Processor=80286, turn on 80286 flag **)
  jz @is80286;		(** If no bits set, processor is 80286 **)
  mov @Result, $0ffff;
@is80286:
  push	bx;
  popf;
end;

(******************************************************************************)

function check_80386 : Word; assembler;register;
(** Returns:
   3      if processor 80386
   0xffff otherwise
**)
asm
 mov bx, sp;
 and sp, not 3;
 pushfd;		(** Push original EFLAGS **)
 pop eax;		(** Get original EFLAGS **)
 mov ecx, eax;		(** Save original EFLAGS **)
 xor eax, $40000;	(**  Flip AC bit in EFLAGS **)
 push eax;		(** Save new EFLAGS value on stack **)
 popfd;			(** Replace current EFLAGS value **)
 pushfd;		(** Get new EFLAGS **)
 pop eax;		(** Store new EFLAGS in EAX **)
 xor eax, ecx;		(** Can't toggle AC bit, so processor=80386 **)
 mov @Result, 3;	(** Turn on 80386 processor flag **)
 jz  @is80386;		(** Jump if 80386 processor **)
 mov @Result, $0ffff;
@is80386:
 push	ecx;
 popfd;
 mov sp, bx;		(** Restore SP **)
 and eax, $0000ffff;
end;

(******************************************************************************)

function GetCPUID4 :DWORD; assembler;register;
(** This function retrieves a set of CPUID flags,
    one of which, is whether the TimeStamp counter exists **)
asm
  PUSH    EBX		(** Save registers **)
  PUSH    EDI
  MOV     EAX,1 	(** Set up for CPUID **)
  DW      $A20F 	(** CPUID OpCode **)
  MOV @Result,EDX	(** Put the flag array into a DWord **)
  POP     EDI		(** Restore registers **)
  POP     EBX
end;

(******************************************************************************)

Function TCPUID.FormatSeconds(TotalSeconds:Double;WholeSecondsOnly,DisplayAll:Boolean):String;
(** INPUT: A floating-point number of Seconds

    OUTPUT: A fully-formatted string
    **)
Var
 lcenturies,lyears,lmonths,lminutes,lhours,ldays,lweeks:Word;
 //lSecs,lFracSeconds:Double;
 lSecs: Double;
 s:Array[1..8] of String;
 SecondsPerCentury:Comp;
 FS:String;
begin
//lcenturies:=0;
//lyears:=0;
//lmonths:=0;
//lweeks:=0;
//ldays:=0;
//lhours:=0;
//lminutes:=0;
//lsecs:=0;
//lFracSeconds:=0;

(** Suppress the decimal part if Whole Seconds Only is desired **)
If WholeSecondsOnly then FS:='%.0f' else FS:='%.2f';

(** Split the calculation to avoid an overflow **)
SecondsPerCentury:=36550 * 24;
SecondsPerCentury:= SecondsPerCentury * 3600;
(** Get centuries **)
lcenturies:=Trunc(TotalSeconds / SecondsPerCentury);
TotalSeconds:=TotalSeconds-(lcenturies * SecondsPerCentury);

(** Get years **)
lyears:=Trunc(TotalSeconds / (365.5 * 24 * 3600));
TotalSeconds:=TotalSeconds-(lyears * (365.5 * 24 * 3600));

(** Get months **)
lmonths:=Trunc(TotalSeconds / (31 * 24 * 3600));
TotalSeconds:=TotalSeconds-(lmonths * (31 * 24 * 3600));

(** Get weeks **)
lweeks:=Trunc(TotalSeconds / (7 * 24 * 3600));
TotalSeconds:=TotalSeconds-(lweeks * (7 * 24 * 3600));

(** Get days **)
ldays:=Trunc(TotalSeconds / (24 * 3600));
TotalSeconds:=TotalSeconds-(ldays * (24 * 3600));

(** Get Hours **)
lhours:=Trunc(TotalSeconds / 3600);
TotalSeconds:=TotalSeconds-(lhours * 3600);

(** Get minutes **)
lminutes:=Trunc(TotalSeconds / 60);
TotalSeconds:=TotalSeconds-(lminutes * 60);

(** Get seconds **)
If WholeSecondsOnly then lsecs:=Trunc(TotalSeconds)
else lsecs:=TotalSeconds;

(** Get fractions of a second **)
//lFracSeconds:=TotalSeconds-lsecs;

(** Deal with single values **)
if lCenturies=1 then s[1]:=' Century, ' else s[1]:=' Centuries, ';
if lyears=1 then s[2]:=' Year, ' else s[2]:=' Years, ';
if lmonths=1 then s[3]:=' Month, ' else s[3]:=' Months, ';
if lweeks=1 then s[4]:=' Week, ' else s[4]:=' Weeks, ';
if ldays=1 then s[5]:=' Day, ' else s[5]:=' Days, ';
if lhours=1 then s[6]:=' Hour, ' else s[6]:=' Hours, ';
if lminutes=1 then s[7]:=' Minute, ' else s[7]:=' Minutes, ';
if lsecs=1 then s[8]:=' Second.' else s[8]:=' Seconds.';

If DisplayAll then
 Result:= Format('%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s' + FS + '%s',
 [lcenturies,s[1],lyears,s[2],lmonths,s[3],lweeks,s[4],ldays,s[5],lhours,s[6],lminutes,s[7],lSecs,s[8]])
else
 if lCenturies>=1 then
  Result:= Format('%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s' + FS + '%s',
  [lcenturies,s[1],lyears,s[2],lmonths,s[3],lweeks,s[4],ldays,s[5],lhours,s[6],lminutes,s[7],lsecs,s[8]])
 else
  if lyears>=1 then
   Result:= Format('%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s' + FS + '%s',
   [lyears,s[2],lmonths,s[3],lweeks,s[4],ldays,s[5],lhours,s[6],lminutes,s[7],lsecs,s[8]])
  else
   if lmonths>=1 then
    Result:= Format('%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s' + FS + '%s',
    [lmonths,s[3],lweeks,s[4],ldays,s[5],lhours,s[6],lminutes,s[7],lsecs,s[8]])
   else
    if lweeks>=1 then
     Result:= Format('%.0d%s%.0d%s%.0d%s%.0d%s' + FS + '%s',
     [lweeks,s[4],ldays,s[5],lhours,s[6],lminutes,s[7],lsecs,s[8]])
    else
     if ldays>=1 then
      Result:= Format('%.0d%s%.0d%s%.0d%s' + FS + '%s',
      [ldays,s[5],lhours,s[6],lminutes,s[7],lsecs,s[8]])
     else
      if lhours>=1 then
       Result:= Format('%.0d%s%.0d%s' + FS + '%s',
       [lhours,s[6],lminutes,s[7],lsecs,s[8]])
      else
       if lminutes>=1 then
 Result:= Format('%.0d%s' + FS + '%s',
 [lminutes,s[7],lsecs,s[8]])
       else
 Result:= Format(FS + '%s',
 [lsecs,s[8]]);

end;
(******************************************************************************)


end.

